open Lexical;;
module Parser = Castling.ParserGenerator (Token);;
open Parser;;

let rec program = lazy !! (
	element (Reserved PROGRAM) >>
	identifier >>
	program_io >>
	element Semicolon >>
	declarations >>
	element (Reserved BEGIN) >>
	statements >>
	element (Reserved END) >>
	element Period
) and program_io = lazy !! (
	one_of ~name:"program_io" [
		"no_io", epsilon;
		"has_io", element Open_paren >> nullable_name_list >> element Close_paren]
) and name_list = lazy !! (
	one_of ~name:"name_list" [
		"end_name", identifier;
		"next_name", identifier >> element Comma >> name_list]
) and nullable_name_list = lazy !! (
	one_of ~name:"name_list" [
		"", name_list;
		"no_name", epsilon]
) and declarations = lazy !! (
	one_of ~name:"declarations" [
		"end_decl", epsilon;
		"next_decl", declaration >> declarations]
) and declaration = lazy !! (
	one_of ~name:"declaration" [
		"type", element (Reserved TYPE) >> type_list;
		"const", element (Reserved CONST) >> const_list;
		"var", element (Reserved VAR) >> var_list;
		"label", element (Reserved LABEL) >> label_list >> element Semicolon;
		"procedure", procedure_decl;
		"function", function_decl]
) and type_list = lazy !! (
	one_of ~name:"type_list" [
		"end_type", type_decl;
		"next_type", type_decl >> type_list]
) and type_decl = lazy !! (
	identifier >> element EQ >> type_expr >> element Semicolon
) and const_list = lazy !! (
	one_of ~name:"const_list" [
		"end_const", const;
		"next_const", const >> const_list]
) and const = lazy !! (
	identifier >> element EQ >> expression >> element Semicolon
) and var_list = lazy !! (
	one_of ~name:"var_list" [
		"end_var", epsilon;
		"next_var", var >> var_list]
) and var = lazy !! (
	name_list >> element Colon >> type_expr >> element Semicolon
) and label_list = lazy !! (
	one_of ~name:"label_list" [
		"end_label", label;
		"next_label", label >> element Comma >> label_list]
) and label = lazy !! (
	one_of ~name:"label" [
		"identifier_label", identifier;
		"numeric_label", integer]
) and pattern = lazy !! (
	one_of ~name:"pattern" [
		"simple_pattern", expression;
		"range_pattern", expression >> element Range >> expression]
) and pattern_list = lazy !! (
	one_of ~name:"pattern_list" [
		"end_pattern", pattern;
		"next_pattern", pattern >> element Comma >> pattern]
) and variant = lazy !! (
	pattern_list >> element Colon >> element Open_paren >> var_list >> element Close_paren >> element Semicolon
) and variant_list = lazy !! (
	one_of ~name:"variant_list" [
		"end_variant", variant;
		"next_variant", variant >> variant_list]
) and variant_part = lazy !! (
	one_of ~name:"variant_part" [
		"has_variant_part", element (Reserved CASE) >>
			identifier >> element Colon >> type_expr >> element (Reserved OF) >> variant_list;
		"no_variant_part", epsilon]
) and composite_type = lazy !! (
	one_of ~name:"type_expr" [
		"record", element (Reserved RECORD) >> var_list >> variant_part >> element (Reserved END);
		"set", element (Reserved SET) >> element (Reserved OF) >> type_expr;
		"array", element (Reserved ARRAY) >>
			element Open_bracket >> type_expr >> element Close_bracket >>
			element (Reserved OF) >> type_expr]
) and type_expr = lazy !! (
	one_of ~name:"type_expr" [
		"type_ref", identifier;
		"range_type", simple_unary >> element Range >> expression;
		"enum_type", element Open_paren >> name_list >> element Close_paren;
		"", composite_type;
		"packed_type", element (Reserved PACKED) >> composite_type;
		"pointer", element Caret >> identifier]
) and argument_list = lazy !! (
	one_of ~name:"argument_list" [
		"end_argument", expression;
		"next_argument", expression >> element Comma >> argument_list]
) and nullable_argument_list = lazy !! (
	one_of ~name:"argument_list" [
		"", argument_list;
		"no_argument", epsilon]
) and primary = lazy !! (
	one_of ~name:"expression" [
		"name", identifier;
		"call", identifier >> skip (element Open_paren) >> nullable_argument_list >> skip (element Close_paren);
		"nil", element (Reserved NIL);
		"integer", integer;
		"real", real;
		"string", string;
		"field", primary >> element Period >> identifier;
		"dereference", primary >> element Caret]
) and simple_unary = lazy !! (
	one_of ~name:"expression" [
		"", primary;
		"address_of", element At >> unary;
		"plus", element Plus >> unary;
		"minus", element Minus >> unary;
		"not", element (Reserved NOT) >> unary]
) and unary = lazy !! (
	one_of ~name:"expression" [
		"", simple_unary;
		"", skip (element Open_paren) >> expression >> skip (element Close_paren);
		"set_literal", skip (element Open_bracket) >> nullable_argument_list >> skip (element Close_bracket)]
) and term = lazy !! (
	one_of ~name:"expression" [
		"", unary;
		"mul", term >> element Asterisk >> unary;
		"fdiv", term >> element Slash >> unary;
		"idiv", term >> element (Reserved DIV) >> unary;
		"mod", term >> element (Reserved MOD) >> unary;
		"and", term >> element (Reserved AND) >> unary]
) and sum = lazy !! (
	one_of ~name:"expression" [
		"", term;
		"add", sum >> element Plus >> term;
		"sub", sum >> element Minus >> term;
		"or", sum >> element (Reserved OR) >> term;
		"xor", sum >> element (Reserved XOR) >> term]
) and expression = lazy !! (
	one_of ~name:"expression" [
		"", sum;
		"eq", expression >> element EQ >> sum;
		"ne", expression >> element NE >> sum;
		"gt", expression >> element GT >> sum;
		"ge", expression >> element GE >> sum;
		"lt", expression >> element LT >> sum;
		"le", expression >> element LE >> sum;
		"in", expression >> element (Reserved IN) >> sum]
) and alternative = lazy !! (
	pattern_list >> element Colon >> statement >> element Semicolon
) and alternative_list = lazy !! (
	one_of ~name:"alternative_list" [
		"end_alternative", alternative;
		"next_alternative", alternative >> alternative_list]
) and for_loop_range = lazy !! (
	identifier >>
	element Assign >>
	one_of ~name:"for_loop_range" [
		"upto", expression >> element (Reserved TO) >> expression;
		"downto", expression >> element (Reserved DOWNTO) >> expression]
) and closed_statement = lazy !! (
	one_of ~name:"statement" [
		"empty_statement", epsilon;
		"call_statement", expression;
		"assignment", expression >> element Assign >> expression;
		"goto", element (Reserved GOTO) >> label;
		"case", element (Reserved CASE) >> expression >> element (Reserved OF) >>
			alternative_list >> element (Reserved END);
		"repeat", element (Reserved REPEAT) >> statements >> element (Reserved UNTIL) >> expression;
		"block", element (Reserved BEGIN) >> statements >> element (Reserved END);
		"with", element (Reserved WITH) >> expression >> element (Reserved DO) >> closed_statement;
		"while", element (Reserved WHILE) >> expression >> element (Reserved DO) >> closed_statement;
		"for", element (Reserved FOR) >> for_loop_range >> element (Reserved DO) >> closed_statement;
		"if_else", element (Reserved IF) >> expression >> element (Reserved THEN) >> closed_statement >>
			element (Reserved ELSE) >> closed_statement]
) and open_statement = lazy !! (
	one_of ~name:"statement" [
		"with", element (Reserved WITH) >> expression >> element (Reserved DO) >> open_statement;
		"while", element (Reserved WHILE) >> expression >> element (Reserved DO) >> open_statement;
		"for", element (Reserved FOR) >> for_loop_range >> element (Reserved DO) >> open_statement;
		"if", element (Reserved IF) >> expression >> element (Reserved THEN) >> statement;
		"if_else", element (Reserved IF) >> expression >> element (Reserved THEN) >> closed_statement >>
			element (Reserved ELSE) >> open_statement]
) and statement = lazy !! (
	one_of ~name:"statement" [
		"", open_statement;
		"", closed_statement]
) and statements = lazy !! (
	one_of ~name:"statements" [
		"end_statement", statement;
		"next_statement", statement >> element Semicolon >> statements]
) and formal = lazy !! (
	one_of ~name:"formal" [
		"by_value_formal", name_list >> element Colon >> type_expr;
		"const_formal", element (Reserved CONST) >> name_list >> element Colon >> type_expr;
		"var_formal", element (Reserved VAR) >> name_list >> element Colon >> type_expr;
		"procedure_formal", procedure_header;
		"function_formal", function_header]
) and formal_list = lazy !!(
	one_of ~name:"formal_list" [
		"end_formal", formal;
		"next_formal", formal >> element Semicolon >> formal_list]
) and formals = lazy !! (
	one_of ~name:"formal_list" [
		"no_formal", epsilon;
		"", skip (element Open_paren) >> formal_list >> skip (element Close_paren)]
) and procedure_header = lazy !! (
	element (Reserved PROCEDURE) >> identifier >> formals
) and procedure_decl = lazy !! (
	procedure_header >> element Semicolon >>
	declarations >>
	element (Reserved BEGIN) >>
	statements >>
	element (Reserved END) >> element Semicolon
) and function_header = lazy !! (
	element (Reserved FUNCTION) >> identifier >> formals >> element Colon >> type_expr
) and function_decl = lazy !! (
	function_header >> element Semicolon >>
	declarations >>
	element (Reserved BEGIN) >>
	statements >>
	element (Reserved END) >> element Semicolon
) and identifier = lazy !! (
	element (Identifier "NAME")
) and integer = lazy !! (
	element (Integer 0)
) and real = lazy !! (
	element (Real 0.0)
) and string = lazy !! (
	element (String "STRING")
);;

debug := try Sys.argv.(1) = "-v" with Invalid_argument _ -> false;;
ranged_position := true;;
pretty_printer := true;;
error_printer := true;;
runtime_debug := true;;
generate program;;
Printf.eprintf "OK. (time: %f sec)\n" (Sys.time ());;
